home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / mod2tutb.zip / LIST.MOD < prev    next >
Text File  |  1989-01-18  |  7KB  |  224 lines
  1. MODULE List;   (* Program to list Modula-2 source files with page  *)
  2.                (* numbers and line numbers.                        *)
  3.  
  4. FROM FileSystem IMPORT Lookup, Close, File, ReadChar, Response,
  5.                        WriteChar;
  6. FROM Conversions IMPORT ConvertCardinal;
  7. FROM TimeDate IMPORT GetTime, Time;
  8. IMPORT ASCII;
  9. IMPORT InOut;
  10.  
  11. TYPE BigString   = ARRAY[1..80] OF CHAR;
  12.      SmallString = ARRAY[1..25] OF CHAR;
  13.  
  14. VAR InFile     : File;          (* The Input File record            *)
  15.     Printer    : File;          (* The Printer File record          *)
  16.     NameOfFile : SmallString;   (* Storage for the filename         *)
  17.     InputLine  : BigString;     (* The Input line of characters     *)
  18.     LineNumber : CARDINAL;      (* The current line number          *)
  19.     LinesOnPage : CARDINAL;     (* Number of Lines on this page     *)
  20.     PageNumber  : CARDINAL;     (* Page Number                      *)
  21.     Index       : CARDINAL;     (* Used locally in several proc's   *)
  22.     Year,Day,Month     : CARDINAL;
  23.     Hour,Minute,Second : CARDINAL;
  24.     GoodFile    : BOOLEAN;
  25.  
  26. (* ************************************************ WriteCharString *)
  27. (* Since there is no WriteString procedure in the FileSystem        *)
  28. (* module, this procedure does what it would do.  It outputs a      *)
  29. (* string until it comes to the end of it or until it comes to a    *)
  30. (* character 0.                                                     *)
  31. PROCEDURE WriteCharString(CharString : ARRAY OF CHAR);
  32. BEGIN
  33.    Index := 0;
  34.    LOOP
  35.       IF Index > HIGH(CharString) THEN EXIT END; (* Max = 80 chars  *)
  36.       IF CharString[Index] = 0C THEN EXIT END;   (* If a 0C is found*)
  37.       WriteChar(Printer,CharString[Index]);
  38.       INC(Index);
  39.    END;
  40. END WriteCharString;
  41.  
  42.  
  43. (* ************************************************* WriteLnPrinter *)
  44. (* Since there is no WriteLn procedure in the FileSystem module,    *)
  45. (* procedure does its job.                                          *)
  46. PROCEDURE WriteLnPrinter;
  47. CONST CRLF = 12C;
  48. BEGIN
  49.    WriteChar(Printer,CRLF);
  50. END WriteLnPrinter;
  51.  
  52.  
  53. (* ************************************************* GetFileAndOpen *)
  54. (* This procedure requests the filename, receives it, and opens the *)
  55. (* source file for reading and printing.  It loops until a valid    *)
  56. (* filename is found.                                               *)
  57. PROCEDURE GetFileAndOpen(VAR GoodFile : BOOLEAN);
  58. BEGIN
  59.    InOut.WriteLn;
  60.    InOut.WriteString("Name of file to print ---> ");
  61.    InOut.ReadString(NameOfFile);
  62.    Lookup(InFile,NameOfFile,FALSE);
  63.    IF InFile.res = done THEN
  64.       GoodFile := TRUE;
  65.       Lookup(Printer,"PRN",TRUE);            (* open printer as a file *)
  66.    ELSE
  67.       GoodFile := FALSE;
  68.       InOut.WriteString("   File doesn't exist");
  69.       InOut.WriteLn;
  70.    END;
  71. END GetFileAndOpen;
  72.  
  73.  
  74. (* ***************************************************** Initialize *)
  75. (* This procedure initializes some of the counters.                 *)
  76. PROCEDURE Initialize;
  77. VAR PackedTime : Time;
  78. BEGIN
  79.    LineNumber := 1;
  80.    LinesOnPage := 0;
  81.    PageNumber := 1;
  82.    GetTime(PackedTime);
  83.    Day := PackedTime.day MOD 32;
  84.    Month := PackedTime.day DIV 32;
  85.    Month := Month MOD 16;
  86.    Year := 1900 + PackedTime.day DIV 512;
  87.    Hour := PackedTime.minute DIV 60;
  88.    Minute := PackedTime.minute MOD 60;
  89.    Second := PackedTime.millisec DIV 1000;
  90. END Initialize;
  91.  
  92.  
  93. (* *********************************************** PrintTimeAndDate *)
  94. (* This procedure prints the time and date at the top of every page *)
  95. PROCEDURE PrintTimeAndDate;
  96. VAR OutChars : ARRAY[0..4] OF CHAR;
  97. BEGIN
  98.    WriteCharString("      ");
  99.    ConvertCardinal(Hour,2,OutChars);
  100.    WriteCharString(OutChars);
  101.    WriteCharString(":");
  102.    ConvertCardinal(Minute,2,OutChars);
  103.    WriteCharString(OutChars);
  104.    WriteCharString(":");
  105.    ConvertCardinal(Second,2,OutChars);
  106.    WriteCharString(OutChars);
  107.    WriteCharString("  ");
  108.    ConvertCardinal(Month,2,OutChars);
  109.    WriteCharString(OutChars);
  110.    WriteCharString("/");
  111.    ConvertCardinal(Day,2,OutChars);
  112.    WriteCharString(OutChars);
  113.    WriteCharString("/");
  114.    ConvertCardinal(Year,4,OutChars);
  115.    WriteCharString(OutChars);
  116. END PrintTimeAndDate;
  117.  
  118.  
  119. (* *************************************************** OutputHeader *)
  120. (* This procedure prints the filename at the top of each page along *)
  121. (* with the page number.                                            *)
  122. PROCEDURE OutputHeader;
  123. VAR PageOut : ARRAY[1..4] OF CHAR;
  124. BEGIN
  125.    WriteCharString("   Filename --> ");
  126.    WriteCharString(NameOfFile);
  127.    WriteCharString("           ");
  128.    PrintTimeAndDate;
  129.    WriteCharString("   Page");
  130.    ConvertCardinal(PageNumber,4,PageOut);
  131.    WriteCharString(PageOut);
  132.    WriteLnPrinter;
  133.    WriteLnPrinter;
  134.    INC(PageNumber);
  135. END OutputHeader;
  136.  
  137.  
  138. (* *************************************************** OutputFooter *)
  139. (* This procedure outputs 8 blank lines at the bottom of each page. *)
  140. (* Note; The user may wish to change this to a formfeed character.  *)
  141. PROCEDURE OutputFooter;
  142. BEGIN
  143.    FOR Index := 1 TO 8 DO
  144.       WriteLnPrinter;
  145.    END;
  146. END OutputFooter;
  147.  
  148.  
  149. (* ******************************************************* GetALine *)
  150. (* This procedure inputs a line from the source file.  It quits when*)
  151. (* it finds an end-of-line, an end-of-file, or after it gets 80     *)
  152. (* characters.                                                      *)
  153. PROCEDURE GetALine;
  154. VAR LocalChar : CHAR;
  155. BEGIN
  156.    FOR Index := 1 TO 80 DO      (* clear the input area so that the *)
  157.       InputLine[Index] := 0C;   (* search for 0C will work.         *)
  158.    END;
  159.  
  160.    Index := 1;
  161.    LOOP
  162.       ReadChar(InFile,LocalChar);
  163.       IF InFile.eof THEN EXIT END;
  164.       InputLine[Index] := LocalChar;
  165.       IF LocalChar = ASCII.EOL THEN EXIT END;
  166.       INC(Index);
  167.       IF Index = 81 THEN EXIT END;
  168.    END;
  169. END GetALine;
  170.  
  171.  
  172. (* ***************************************************** OutputLine *)
  173. (* Output a line of test with the line number in front of it, after *)
  174. (* checking to see if the page is full.                             *)
  175. PROCEDURE OutputLine;
  176. VAR Count       : CARDINAL;
  177.     CardOutArea : ARRAY[1..8] OF CHAR;
  178. BEGIN
  179.    INC(LinesOnPage);
  180.    IF LinesOnPage > 56 THEN
  181.       OutputFooter;
  182.       OutputHeader;
  183.       LinesOnPage := 1;
  184.    END;
  185.    ConvertCardinal(LineNumber,6,CardOutArea);
  186.    INC(LineNumber);
  187.    WriteCharString(CardOutArea);
  188.    WriteCharString("  ");
  189.    WriteCharString(InputLine);
  190. END OutputLine;
  191.  
  192.  
  193. (* *************************************************** SpacePaperUp *)
  194. (* At the end of the listing, space the paper up so that a new page *)
  195. (* is ready for the next listing.                                   *)
  196. PROCEDURE SpacePaperUp;
  197. VAR Count : CARDINAL;
  198. BEGIN
  199.    Count := 64 - LinesOnPage;
  200.    FOR Index := 1 TO Count DO
  201.       WriteLnPrinter;
  202.    END;
  203.    Close(InFile);
  204.    Close(Printer);
  205. END SpacePaperUp;
  206.  
  207.  
  208. (* *************************************************** Main Program *)
  209. (* This is nothing more than a big loop.  It needs no comment.      *)
  210. BEGIN
  211.    GetFileAndOpen(GoodFile);
  212.    IF GoodFile THEN
  213.       Initialize;
  214.       OutputHeader;
  215.       REPEAT
  216.          GetALine;
  217.          IF NOT InFile.eof THEN
  218.             OutputLine;
  219.          END;
  220.       UNTIL InFile.eof;
  221.       SpacePaperUp;
  222.    END;
  223. END List.
  224.